home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / compiler / Arg.sml < prev    next >
Encoding:
Text File  |  1997-08-18  |  2.5 KB  |  84 lines  |  [TEXT/R*ch]
  1. (* arg.sml *)
  2.  
  3. open BasicIO Fnlib;
  4.  
  5. exception Bad of string
  6.  
  7. datatype spec =
  8.     String  of (string -> unit)
  9.   | Int     of (int -> unit)
  10.   | Unit    of (unit -> unit)
  11.   | Real    of (real -> unit)
  12. ;
  13.  
  14. datatype error =
  15.     Unknown of string
  16.   | Wrong of string * string * string  (* option, actual, expected *)
  17.   | Missing of string
  18.   | Message of string
  19. ;
  20.  
  21. fun stop error =
  22.   let val progname = if Vector.length Miscsys.command_line > 0
  23.                      then Vector.sub(Miscsys.command_line, 0)
  24.                      else "(?)"
  25.       val message =
  26.         case error of
  27.             Unknown s =>
  28.               progname ^ ": unknown option: \"" ^ s ^ "\"."
  29.           | Missing s
  30.               => progname ^ ": option \"" ^ s ^ "\" needs an argument."
  31.           | Wrong (opt, arg, expected)
  32.               => progname ^ ": wrong argument \"" ^ arg ^ "\"; option \""
  33.                    ^ opt ^ "\" expects " ^ expected ^ "."
  34.           | Message s
  35.               => progname ^ ": " ^ s
  36.   in
  37.      output(std_err, message); output(std_err, "\n"); flush_out std_err;
  38.      exit 2
  39.   end;
  40.  
  41. prim_val sml_int_of_string : string -> int = 1 "sml_int_of_string";
  42. prim_val sml_float_of_string : string -> real = 1 "sml_float_of_string";
  43.  
  44. fun listOfVector v =
  45.   List.tabulate(Vector.length v, fn i => Vector.sub(v, i))
  46. ;
  47.  
  48. fun parse speclist anonfun =
  49.   let fun p [] = ()
  50.         | p (s::t) =
  51.             if size s >= 1 andalso CharVector.sub(s, 0) = #"-"
  52.             then do_key s t
  53.             else ((anonfun s; p t)
  54.                    handle Bad m => stop (Message m))
  55.       and do_key s l =
  56.         let val action =
  57.               lookup s speclist
  58.                 handle Subscript => stop (Unknown s)
  59.         in
  60.           (case (action, l) of
  61.                (Unit f, l) => (f (); p l)
  62.              | (String f, arg::t) => (f arg; p t)
  63.              | (Int f, arg::t) =>
  64.                  let val arg_i =
  65.                        sml_int_of_string arg
  66.                        handle Fail _ =>
  67.                          stop (Wrong (s, arg, "an integer"))
  68.                  in f arg_i; p t end
  69.              | (Real f, arg::t) =>
  70.                  let val arg_r =
  71.                        sml_float_of_string arg
  72.                        handle Fail _ =>
  73.                          stop (Wrong (s, arg, "a real"))
  74.                  in f arg_r; p t end
  75.              | (_, []) => stop (Missing s)
  76.           ) handle Bad m => stop (Message m)
  77.         end
  78.   in
  79.     case listOfVector Miscsys.command_line of
  80.         [] => ()
  81.       | a::l => p l
  82.   end;
  83.  
  84.